final_project_draft

Political Donations of Professional Sports Team Owners

Top 25 Highest Political Donations by NFL Team Owners in 2016

Table of Owners Who Make the Most Donations

library(knitr)
library(pander)
library(tidyverse)
library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

owner_rank2 <- pol_donations %>% group_by(Owner, Team, League) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 65)

## `summarise()` has grouped output by 'Owner', 'Team'. You can override using the `.groups` argument.

kable(owner_rank2, caption = "<b>Who Makes the Most Donations Across All Leagues?<b>", format = "html",
      col.names = c("Owner", "Team", "League", "Donations Made")) %>%
  kable_styling(html_font = "Cambria", bootstrap_options = "striped",
                font_size = 9) 

Who Makes the Most Donations Across All Leagues?

Owner	Team	League	Donations Made
Charles Johnson	San Francisco Giants	MLB	213
Micky Arison	Miami Heat	NBA	178
John Rogers	Chicago Sky	WNBA	149
Dan DeVos	Orlando Magic	NBA	116
Jody Allen (Paul G. Allen Trust)	Portland Trail Blazers, Seattle Seahawks	NBA, NFL	108
Jimmy and Susan Haslam	Cleveland Browns	NFL	102
Ken Kendrick	Arizona Diamondbacks	MLB	86
Jerry Reinsdorf	Chicago Bulls, Chicago White Sox	NBA, MLB	78
Herbert Simon	Indiana Pacers, Indiana Fever	NBA, WNBA	68
Stephen M. Ross	Miami Dolphins	NFL	65

How Much Do They Donate?

Examining Top Donator

library(ggthemes)
charles_johnson <- pol_donations %>% filter(Owner == "Charles Johnson") %>%
  filter(year == 2016 | year == 2018 | year == 2020) 

cj_party <- charles_johnson %>% group_by(Party) %>%
  summarise(n = n()) %>%
  mutate(party = fct_reorder(.f = Party, .x = n)) %>%
   mutate(Party = fct_relevel(party, c("Republican", "Bipartisan, but mostly Republican",
                                         "Democrat")))

level_order2 <- factor(charles_johnson$Party, level = c('Republican', 'Democrat', 'Bipartisan, but mostly Republican'))

ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
  geom_col() +
  coord_flip() +
  scale_fill_viridis_d(option = "plasma") +
  labs(title = "Is There Any Political Party Receiving More Support From Charles Johnson?",
       x = " ",
       y = "Count of Donations") +
  theme(legend.position = "bottom",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  hjust = 0.5,
                                  size = 13,
                                  margin = margin(c(t = 50,
                                                    b = 50)),
                                  vjust = 10),
        axis.text = element_text(family = "mono"),
        legend.title = element_text(family = "mono",
                                    face = "bold"),
        legend.text = element_text(family = "mono"),
        axis.ticks.y = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_text(family = "mono",
                                    size = 9,
                                    face = "italic",
                                    margin = margin(t = 20)))

cj_party2 <- cj_party %>% select(n, party)

ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
  geom_col() + 
  annotate(geom = "table") +
  coord_flip()

What Are Some of These Organizations?

organizations <- charles_johnson %>% group_by(Recipient, Party) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 2)

## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.

kable(organizations, caption = "<b>What Are Some Organizations Charles Johnson Donates To?<b>",
      col.names = c("Recipient", "Political Party", "Amount of Donations Made"))  %>%
  kable_styling(html_font = "Cambria", bootstrap_options = "striped",
                font_size = 15) %>%
  scroll_box(height = "500px")

What Are Some Organizations Charles Johnson Donates To?

Recipient	Political Party	Amount of Donations Made
CONGRESSIONAL LEADERSHIP FUND	Republican	3
MOONEY VICTORY FUND	Republican	3
SENATE LEADERSHIP FUND	Republican	3
TRUMP VICTORY	Republican	3
VIGOP (VIRGIN ISLANDS REPUBLICAN PARTY)	Republican	3
ALEX MOONEY FOR CONGRESS	Republican	2
CHIP ROY FOR CONGRESS	Republican	2
CORNYN MAJORITY COMMITTEE	Republican	2
FASO FOR CONGRESS	Republican	2
HURD FOR CONGRESS	Republican	2
INVESTMENT COMPANY INSTITUTE POLITICAL ACTION COMMITTEE	Bipartisan, but mostly Republican	2
JACKIE SPEIER FOR CONGRESS	Democrat	2
KATKO FOR CONGRESS	Republican	2
MAST VICTORY COMMITTEE	Republican	2
MCSALLY FOR SENATE INC	Republican	2
RESTORATION PAC	Republican	2
TEAM RYAN	Republican	2
TRUE NORTH PAC	Republican	2
WALTERS FOR CONGRESS	Republican	2
ZELDIN FOR CONGRESS	Republican	2

Organizations Receiving Most Donations Across All Leagues

recipients <- pol_donations %>% group_by(Recipient, Party) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 15) %>%
  ungroup() %>%
  mutate(recipient = fct_reorder(.f = Recipient, .x = n)) %>%
  mutate(Party = fct_relevel(Party, c("Bipartisan", "Republican", "Democrat")))

## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.

new_names <- c("Collins For Senator", "McSally for Senate Inc.",
               "ActBlue", "Portman For Senate Committee", "NRCC",
               "NRSC", "Hillary Victory Fund", "Team Ryan", 
               "Office of the Commissioner of MLB PAC", "Gridirion PAC")

ggplot(data = recipients, aes(x = recipient, y = n, colour = Party)) +
  geom_point() +
  geom_segment(aes(x = recipient, xend = recipient, y = 0, yend = n)) +
  coord_flip() +
  labs(x = " ",
       y = "Count of Donations") +
  labs(title = "Organizations Receiving Most Donations Among All Owners") +
  scale_colour_brewer(palette = "Dark2") +
  theme(legend.position = "bottom") +
  scale_x_discrete(labels = new_names) +
  theme(plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50,
                                                    b = 50)),
                                  vjust = 10),
        axis.text = element_text(family = "mono"),
        axis.title = element_text(family = "mono",
                                  size = 8),
        axis.title.x = element_text(size = 10,
                                    margin = margin(t = 20,
                                                    b = 10)),
        legend.title = element_text(family = "mono",
                                    face = "bold"),
        legend.text = element_text(family = "mono"),
        axis.ticks = element_blank(),
         legend.box.background = element_rect())

pol_donations %>% group_by(League) %>%
  summarise(n = n()) %>%
  arrange(desc(n))

## # A tibble: 16 × 2
##    League             n
##    <chr>          <int>
##  1 MLB              746
##  2 NBA              462
##  3 NFL              444
##  4 NHL              329
##  5 WNBA             274
##  6 NBA, WNBA        118
##  7 NBA, NFL         109
##  8 NBA, NHL         109
##  9 NBA, MLB          84
## 10 NASCAR            79
## 11 NBA, NHL, WNBA    15
## 12 NHL, NFL          12
## 13 MLB, NHL           7
## 14 MLB, WNBA          6
## 15 NBA, NFL, NHL      3
## 16 MLB, NASCAR        1

Blockbusters: A blockbuster is a Hollywood movie that’s made with a large budget and big stars. A true blockbuster is extremely popular and brings in a lot of money (https://www.vocabulary.com/dictionary/blockbuster).

## # A tibble: 430 × 13
##    release_year rank_in_year imdb_rating mpaa_rating film_title      film_budget
##           <dbl>        <dbl>       <dbl> <chr>       <chr>                 <dbl>
##  1         2019            1         8.5 PG-13       Avengers: Endg…   356000000
##  2         2019            2         7   PG          The Lion King     260000000
##  3         2019            3         7.2 PG          Frozen II         150000000
##  4         2019            4         7.6 PG-13       Spider-Man: Fa…   160000000
##  5         2019            5         6.9 PG-13       Captain Marvel    175000000
##  6         2019            6         7.9 G           Toy Story 4       200000000
##  7         2019            7         8.6 R           Joker              55000000
##  8         2019            8         7   PG          Aladdin           183000000
##  9         2019            9         6.9 PG-13       Star Wars: Epi…   200000000
## 10         2019           10         6.5 PG-13       Fast & Furious…   200000000
## # … with 420 more rows, and 7 more variables: length_in_min <dbl>,
## #   domestic_distributor <chr>, worldwide_gross <dbl>, domestic_gross <dbl>,
## #   genre_1 <chr>, genre_2 <chr>, genre_3 <chr>

Blockbuster Ratings: 1977 to 2019

## # A tibble: 5 × 2
##   mpaa_rating     n
##   <chr>       <int>
## 1 G              23
## 2 PG            133
## 3 PG-13         178
## 4 R              95
## 5 <NA>            1

## # A tibble: 4 × 2
##   mpaa_rating     n
##   <chr>       <int>
## 1 G              23
## 2 PG            133
## 3 PG-13         178
## 4 R              95

Has the Budget for Blockbusters Increased Throughout Time?

ggplot(data = blockbusters, aes(x = release_year, y = film_budget, colour = release_year)) +
  geom_point() +
  geom_smooth(se = FALSE, method = "lm", colour = "black") +
  labs(x = "Release Year",
       y = "Film Budget",
       title = "Has the Budget for Blockbuster Films Increased Throughout Time?",
       subtitle = "Film Budget for Blockbusters: 1977-2019") +
  theme_bw() +
  scale_colour_viridis_c() +
  theme(legend.position = "none",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50, b = 50)),
                                  vjust = 10),
        plot.subtitle = element_text(family = "mono",
                                     face = "italic",
                                     vjust = 5),
        axis.title = element_text(family = "mono",
                                  face = "bold"),
        axis.text = element_text(family = "mono"),
        axis.ticks = element_blank(),
        axis.title.x = element_text(margin = margin(c(l = 20))),
        axis.title.y = element_text(margin = margin(c(t = 20, b = 20, r = 20)))) 

## `geom_smooth()` using formula 'y ~ x'

## need to add more to this visualization 

Which American/Domestic Distributor Has Produced the Most Blockbusters 1977-2019

blockbusters3 <- blockbusters %>% group_by(domestic_distributor) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  mutate(order = fct_reorder(.f = domestic_distributor, .x = n)) %>%
  filter(!n == 1)

ggplot(data = blockbusters3, aes(x = order, y = n, fill = order)) +
  geom_point() +
  geom_segment(aes(x = order, xend = order, y = 0, yend = n)) +
  coord_flip() +
  geom_label(data = blockbusters3, aes(label = n), show.legend = FALSE) +
  labs(x = "Amount of Films Produced",
       y = "Domestic Distributor",
       title = "Amount of Blockbusters Produced by Domestic Distributors: 1977-2019") +
  theme_bw() +
  theme(legend.position = "none",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50)),
                                  vjust = 10),
        axis.title = element_text(family = "mono",
                                  face = "bold"),
        axis.text = element_text(family = "mono"),
        axis.text.y = element_text(face = "italic"),
        axis.ticks = element_blank(),
        axis.title.x = element_text(margin = margin(c(b = 20))),
        axis.title.y = element_text(margin = margin(c(t = 30, r = 30))))

Work in Progress

blockbusters

## # A tibble: 430 × 13
##    release_year rank_in_year imdb_rating mpaa_rating film_title      film_budget
##           <dbl>        <dbl>       <dbl> <chr>       <chr>                 <dbl>
##  1         2019            1         8.5 PG-13       Avengers: Endg…   356000000
##  2         2019            2         7   PG          The Lion King     260000000
##  3         2019            3         7.2 PG          Frozen II         150000000
##  4         2019            4         7.6 PG-13       Spider-Man: Fa…   160000000
##  5         2019            5         6.9 PG-13       Captain Marvel    175000000
##  6         2019            6         7.9 G           Toy Story 4       200000000
##  7         2019            7         8.6 R           Joker              55000000
##  8         2019            8         7   PG          Aladdin           183000000
##  9         2019            9         6.9 PG-13       Star Wars: Epi…   200000000
## 10         2019           10         6.5 PG-13       Fast & Furious…   200000000
## # … with 420 more rows, and 7 more variables: length_in_min <dbl>,
## #   domestic_distributor <chr>, worldwide_gross <dbl>, domestic_gross <dbl>,
## #   genre_1 <chr>, genre_2 <chr>, genre_3 <chr>

interest <- blockbusters %>% mutate(rank = rank(desc(imdb_rating))) %>%
  select(rank, everything()) %>%
  arrange(rank) %>%
  slice(1:5) %>%
  mutate(film_title = fct_recode(film_title, 
                                 LOTR_The_Return_Of_The_King = "The Lord of the Rings: The Return of the King",
                                 LOTR_Fellowship_Of_The_Ring = "The Lord of the Rings: The Fellowship of the Ring"))
interest 

## # A tibble: 5 × 14
##    rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
##   <dbl>        <dbl>        <dbl>       <dbl> <chr>       <fct>            <dbl>
## 1   1           2008            1         9   PG-13       The Dark …   185000000
## 2   2.5         2003            1         8.9 PG-13       LOTR_The_…    94000000
## 3   2.5         1993            4         8.9 R           Schindler…    22000000
## 4   5           2010            4         8.8 PG-13       Inception    160000000
## 5   5           2001            2         8.8 PG-13       LOTR_Fell…    93000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## #   worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## #   genre_3 <chr>

interest2 <- blockbusters %>% mutate(rank = rank(imdb_rating)) %>%
  select(rank, everything()) %>%
  arrange(rank) %>%
  slice(1:5)
interest2

## # A tibble: 5 × 14
##    rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
##   <dbl>        <dbl>        <dbl>       <dbl> <chr>       <chr>            <dbl>
## 1   1           1983            5         3.7 PG          Jaws 3-D      20500000
## 2   2           1983           10         4.6 PG          Staying A…    22000000
## 3   3           2009            7         4.7 PG-13       The Twili…    50000000
## 4   4.5         2011            4         4.9 PG-13       The Twili…   110000000
## 5   4.5         1994            6         4.9 PG          The Flint…    46000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## #   worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## #   genre_3 <chr>

library(ggrepel)
ggplot(data = interest, aes(x = release_year, y = domestic_gross)) +
  geom_point(aes(colour = imdb_rating)) +
  geom_label_repel(data = interest, aes(label = film_title)) +
  geom_point(data = interest2, aes(x = release_year, y = domestic_gross, colour = imdb_rating)) +
  geom_label_repel(data = interest2, aes(label = film_title))

History of Rock

## # A tibble: 5,484 × 18
##    index name           artist   release_date length popularity danceability...7
##    <dbl> <chr>          <chr>           <dbl>  <dbl>      <dbl>            <dbl>
##  1     0 Smells Like T… Nirvana          1991   5.03         74            0.502
##  2     1 Stairway to H… Led Zep…         1971   8.05         78            0.338
##  3     2 Bohemian Rhap… Queen            1975   5.91         74            0.392
##  4     3 Imagine - Rem… John Le…         1971   3.13         77            0.547
##  5     4 (I Can't Get … The Rol…         1965   3.71         77            0.723
##  6     5 Hotel Califor… Eagles           1976   6.52         83            0.579
##  7     6 Enter Sandman  Metalli…         1991   5.53         74            0.579
##  8     7 Whole Lotta L… Led Zep…         1969   5.56         77            0.412
##  9     8 Comfortably N… Pink Fl…         1979   6.37         74            0.472
## 10     9 One            U2               1991   4.60         76            0.392
## # … with 5,474 more rows, and 11 more variables: acousticness <dbl>,
## #   danceability...9 <dbl>, energy <dbl>, instrumentalness <dbl>, key <dbl>,
## #   liveness <dbl>, loudness <dbl>, speechiness <dbl>, tempo <dbl>,
## #   time_signature <dbl>, valence <dbl>

Most Popular Nirvana Songs

history_of_rock %>% group_by(artist) %>%
  summarise(n = n()) %>% arrange(desc(n)) 

## # A tibble: 1,738 × 2
##    artist                 n
##    <chr>              <int>
##  1 Various Artists      116
##  2 The Beatles           84
##  3 The Rolling Stones    58
##  4 Led Zeppelin          52
##  5 AC/DC                 43
##  6 Bruce Springsteen     42
##  7 Elvis Presley         33
##  8 Pink Floyd            31
##  9 Bob Dylan             29
## 10 Metallica             29
## # … with 1,728 more rows

nirvana <- history_of_rock %>% rename(Popularity = 'popularity') %>%
  filter(artist == "Nirvana") %>% arrange(desc(Popularity)) %>%
  mutate(order = fct_reorder(.f = name, .x = Popularity)) %>%
  rename(Release_Date = 'release_date')

nirvana %>% select(order, everything())

## # A tibble: 19 × 19
##    order    index name    artist Release_Date length Popularity danceability...7
##    <fct>    <dbl> <chr>   <chr>         <dbl>  <dbl>      <dbl>            <dbl>
##  1 Heart-S…   270 Heart-… Nirva…         1993   4.69         75            0.256
##  2 Smells …     0 Smells… Nirva…         1991   5.03         74            0.502
##  3 The Man…   497 The Ma… Nirva…         1994   4.35         74            0.483
##  4 Come As…    37 Come A… Nirva…         1991   3.65         72            0.5  
##  5 About A…   371 About … Nirva…         2002   2.78         70            0.409
##  6 All Apo…   194 All Ap… Nirva…         1993   3.89         69            0.446
##  7 Lithium    169 Lithium Nirva…         1991   4.28         68            0.678
##  8 Lake Of…   723 Lake O… Nirva…         1994   2.93         66            0.541
##  9 In Bloo…   155 In Blo… Nirva…         1991   4.25         65            0.436
## 10 Rape Me    687 Rape Me Nirva…         1993   2.83         64            0.42 
## 11 Dumb      1325 Dumb    Nirva…         1993   2.53         64            0.697
## 12 Drain Y…  3015 Drain … Nirva…         1991   3.73         60            0.325
## 13 Breed      742 Breed   Nirva…         1991   3.07         59            0.262
## 14 Polly     1103 Polly   Nirva…         1991   2.90         58            0.83 
## 15 Sliver    2642 Sliver  Nirva…         1992   2.27         58            0.428
## 16 Pennyro…  3902 Pennyr… Nirva…         1993   3.65         58            0.428
## 17 On A Pl…  2416 On A P… Nirva…         1991   3.24         54            0.428
## 18 Verse C…  3117 Verse … Nirva…         1991   3.21         35            0.529
## 19 Rainbow…  2914 Rainbo… Nirva…         2018   2.64         25            0.499
## # … with 11 more variables: acousticness <dbl>, danceability...9 <dbl>,
## #   energy <dbl>, instrumentalness <dbl>, key <dbl>, liveness <dbl>,
## #   loudness <dbl>, speechiness <dbl>, tempo <dbl>, time_signature <dbl>,
## #   valence <dbl>

plot3 <- ggplot(data = nirvana, aes(x = order, y = Popularity, label = Popularity, colour = Popularity)) +
  geom_point() +
  geom_segment(aes(x = order, xend = order, y = 0, yend = Popularity)) +
  coord_flip() +
  labs(title = "Most Popular Nirvana Songs: 1991-2018",
       colour = "Popularity", 
       x = " ",
       y = " ") +
  theme_bw() +
  scale_colour_viridis_b() +
  theme(legend.position = "none")

ggplotly(plot3, tooltip = "label")

Trying to Make Density Ridges Plot

## install.packages("ggridges")
library(ggridges)

nirvana_small <- nirvana %>% slice(1:5) %>%
  mutate(order = fct_reorder(.f = name, .x = valence))
ggplot(data = nirvana_small, aes(x = order, y = valence)) +
  geom_density_ridges() +
  coord_flip() +
  labs(x = "Title",
       y = "Valence")

## Picking joint bandwidth of NaN

Works in Progress - Simple Visualizations

nirvana_line <- nirvana %>% rename(Title = 'name')
plot10 <- ggplot(data = nirvana_line, aes(x = Release_Date, y = Popularity, label = Title)) +
  geom_line() +
  geom_point(colour = "darkolivegreen") +
  labs(x = "Release Date",
       y = "Popularity",
       title = "Comparing Popularity by Release Date") +
  theme_bw() +
  theme(legend.position = "none")

ggplotly(plot10, tooltip = "label")

table <- history_of_rock %>% group_by(artist) %>%
  summarise(mean = mean(popularity)) %>%
  arrange(desc(mean)) %>%
  slice(1:10)

top10 <- history_of_rock %>% arrange(desc(popularity)) %>% slice(1:10)

Unemployment Data Set

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

unemployment <- read_csv("data/unemployment_data_us.csv")

## Rows: 132 Columns: 13

## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (2): Month, Date
## dbl (11): Year, Primary_School, High_School, Associates_Degree, Professional...

## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

ggplot(data = unemployment, aes(x = Date, y = Professional_Degree)) +
  geom_point()

## Warning: Removed 9 rows containing missing values (geom_point).